home *** CD-ROM | disk | FTP | other *** search
/ Amoszine 11 / Amoszine 11 (Disk 2 of 2).adf / Loads_Of_Source.lha / wordsearch.amos / wordsearch.amosSourceCode < prev   
AMOS Source Code  |  1980-12-02  |  5KB  |  280 lines
  1. '
  2. '    Wordsearch Maker By Dominic Ramsey
  3. '                April 91
  4. '
  5. ' 2, The Paddocks, Haddenham, Bucks. HP17 8AG. 
  6. '
  7. WORDSEARCH
  8. Procedure WORDSEARCH
  9. Screen Open 0,320,200,2,Lowres : Palette 0,$DFD
  10. Curs Off : Hide On 
  11. Cls 0
  12. Locate 1,1 : Centre "Wordsearch Maker By D. Ramsey"
  13. Locate 1,6 : Centre "This program is designed to be used for"
  14. Print : Centre "making printed wordsearch puzzles,"
  15. Print : Centre "however, if you do not have a printer,"
  16. Print : Centre "the puzzle can be viewed on screen."
  17. Print : Centre "The words are from a 9000 word"
  18. Print : Centre "dictionary stored in bank 10."
  19. Locate 1,19 : Centre "Press mousebutton."
  20. While Mouse Key=0 : Wend 
  21. ML:
  22. Cls : Locate 1,10 : Centre "Please Wait, Designing Wordsearch."
  23. SIZE=22
  24. NW=SIZE+(SIZE/2)+4
  25. If SIZE<15 or SIZE>30 Then Goto ML
  26. Dim WORD$(NW+1),W$(SIZE,SIZE),X(NW+1),Y(NW+1)
  27. For W=1 To NW
  28. A:
  29. R=Rnd(72000)
  30. S=Start(10)
  31. S=S+R
  32. Repeat 
  33.    Inc S
  34. Until Peek(S)=13
  35. Inc S
  36. S$=""
  37. While Peek(S)<>13
  38.    If Peek(S)<65 Then Goto A
  39.    S$=S$+Chr$(Peek(S))
  40.    Inc S
  41. Wend 
  42. If Right$(S$,1)="S" and Rnd(1)=0 Then Goto A
  43. If Len(S$)<5 or Len(S$)>(SIZE) Then Goto A
  44. WORD$(W)=S$
  45. Next W
  46. '
  47. ' sort w$ to do long words first 
  48. For A=1 To NW
  49. For B=A+1 To NW+1
  50. If Len(WORD$(B))>Len(WORD$(A)) Then Swap WORD$(A),WORD$(B)
  51. Next B
  52. Next A
  53. For A=1 To NW
  54. Next 
  55. '
  56. For W=1 To NW
  57. RETRY:
  58. D=Rnd(7)+1
  59. TRY=1
  60. On D Gosub UP,RT,LT,DN,UL,DR,UR
  61. If TRY>60 Then Goto RETRY
  62. Next W
  63. '
  64. '
  65. '
  66. DRW:
  67. Cls 
  68. Centre "Output to screen or printer (S/P)"
  69. Q:
  70. Repeat : Q$=Inkey$ : Until Q$<>""
  71. Q$=Upper$(Q$)
  72. If Q$="S" Then Goto SCRN
  73. If Q$="P" Then Goto PRNT
  74. Goto Q
  75. Stop 
  76. PRNT:
  77. For Y=0 To SIZE
  78. For X=0 To SIZE
  79. If W$(X,Y)=""
  80. W$(X,Y)=Chr$(Rnd(25)+65)
  81. End If 
  82. Lprint W$(X,Y);" ";
  83. Next X
  84. Lprint 
  85. Next Y
  86. Lprint 
  87. Sort WORD$(0)
  88. For VV=1 To NW
  89. If X(VV)>0 and Y(VV)>0
  90. Lprint WORD$(VV)
  91. End If 
  92. Next 
  93. End 
  94. '
  95. SCRN:
  96. Cls 0
  97. For Y=0 To SIZE
  98. For X=0 To SIZE
  99. If W$(X,Y)=""
  100. W$(X,Y)=Chr$(Rnd(25)+65)
  101. End If 
  102. Locate X+8,Y
  103. Print W$(X,Y);" ";
  104. Next X
  105. Next Y
  106. Sort WORD$(0) : WORD$=""
  107. For VV=1 To NW
  108. If X(VV)>0 and Y(VV)>0
  109. WORD$=WORD$+" "+WORD$(VV)
  110. End If 
  111. Next 
  112. '
  113. Screen Open 1,320,200,2,Lowres : Curs Off : Palette 0,$FDD
  114. Print : Centre "Use Mousebutton to swap screens"
  115. Print 
  116. Centre "==============================="
  117. Print : Print : Print 
  118. LL=40
  119. While Len(WORD$)>0
  120. L$=Left$(WORD$,LL)
  121. WORD$=Mid$(WORD$,LL+1)
  122. R$=Right$(L$,1)
  123. If R$<>" "
  124. S=Instr(Flip$(L$)," ")
  125. If S>0
  126. R$=Right$(L$,S-1)
  127. WORD$=R$+WORD$
  128. L$=Left$(L$,Len(L$)-S)
  129. End If 
  130. End If 
  131. L$=Left$(L$+Space$(LL-1),LL)
  132. Print L$
  133. Wend 
  134. SC=0
  135. LP:
  136. While Mouse Key=0 : Wend 
  137. Screen To Front SC
  138. Wait 10
  139. Wait Vbl 
  140. SC=SC xor 1
  141. Goto LP
  142. Stop 
  143. '
  144. End 
  145. '
  146. RT:
  147. Inc TRY
  148. If TRY>60 Then Return 
  149. X=Rnd(SIZE-Len(WORD$(W))-1)
  150. Y=Rnd(SIZE-1)+1
  151. REP=0
  152. For A=1 To Len(WORD$(W))
  153. If W$(X+A,Y)<>"" and(W$(X+A,Y)<>Mid$(WORD$(W),A,1)) Then REP=1
  154. Next A
  155. If REP=1 Then Goto RT
  156. For A=1 To Len(WORD$(W))
  157. W$(X+A,Y)=Mid$(WORD$(W),A,1)
  158. Next A
  159. X(W)=X : Y(W)=Y
  160. Return 
  161. '
  162. LT:
  163. Inc TRY
  164. If TRY>60 Then Return 
  165. X=Rnd(SIZE-1)+1
  166. If X<Len(WORD$(W)) Then Goto LT
  167. Y=Rnd(SIZE-1)+1
  168. REP=0
  169. For A=1 To Len(WORD$(W))
  170. If W$(X-A,Y)<>"" and(W$(X-A,Y)<>Mid$(WORD$(W),A,1)) Then REP=1
  171. Next A
  172. If REP=1 Then Goto LT
  173. For A=1 To Len(WORD$(W))
  174. W$(X-A,Y)=Mid$(WORD$(W),A,1)
  175. Next A
  176. X(W)=X : Y(W)=Y
  177. Return 
  178. '
  179. DN:
  180. Inc TRY
  181. If TRY>60 Then Return 
  182. Y=Rnd(SIZE-Len(WORD$(W))-1)
  183. X=Rnd(SIZE-1)+1
  184. REP=0
  185. For A=1 To Len(WORD$(W))
  186. If W$(X,Y+A)<>"" and(W$(X,Y+A)<>Mid$(WORD$(W),A,1)) Then REP=1
  187. Next A
  188. If REP=1 Then Goto RT
  189. For A=1 To Len(WORD$(W))
  190. W$(X,Y+A)=Mid$(WORD$(W),A,1)
  191. Next A
  192. X(W)=X : Y(W)=Y
  193. Return 
  194. '
  195. UP:
  196. Inc TRY
  197. If TRY>60 Then Return 
  198. Y=Rnd(SIZE-1)+1
  199. If Y<Len(WORD$(W)) Then Goto UP
  200. X=Rnd(SIZE-1)+1
  201. REP=0
  202. For A=1 To Len(WORD$(W))
  203. If W$(X,Y-A)<>"" and(W$(X,Y-A)<>Mid$(WORD$(W),A,1)) Then REP=1
  204. Next A
  205. If REP=1 Then Goto LT
  206. For A=1 To Len(WORD$(W))
  207. W$(X,Y-A)=Mid$(WORD$(W),A,1)
  208. Next A
  209. X(W)=X : Y(W)=Y
  210. Return 
  211. '
  212. UL:
  213. Inc TRY
  214. If TRY>60 Then Return 
  215. Y=Rnd(SIZE-1)+1
  216. If Y<Len(WORD$(W)) Then Goto UL
  217. X=Rnd(SIZE-1)+1
  218. If X<Len(WORD$(W)) Then Goto UL
  219. REP=0
  220. For A=1 To Len(WORD$(W))
  221. If W$(X-A,Y-A)<>"" and(W$(X-A,Y-A)<>Mid$(WORD$(W),A,1)) Then REP=1
  222. Next A
  223. If REP=1 Then Goto UL
  224. For A=1 To Len(WORD$(W))
  225. W$(X-A,Y-A)=Mid$(WORD$(W),A,1)
  226. Next A
  227. X(W)=X : Y(W)=Y
  228. Return 
  229. '
  230. DR:
  231. Inc TRY
  232. If TRY>60 Then Return 
  233. X=Rnd(SIZE-Len(WORD$(W))-1)
  234. Y=Rnd(SIZE-Len(WORD$(W))-1)
  235. REP=0
  236. For A=1 To Len(WORD$(W))
  237. If W$(X+A,Y+A)<>"" and(W$(X+A,Y+A)<>Mid$(WORD$(W),A,1)) Then REP=1
  238. Next A
  239. If REP=1 Then Goto DR
  240. For A=1 To Len(WORD$(W))
  241. W$(X+A,Y+A)=Mid$(WORD$(W),A,1)
  242. Next A
  243. X(W)=X : Y(W)=Y
  244. Return 
  245. '
  246. UR:
  247. Inc TRY
  248. If TRY>60 Then Return 
  249. X=Rnd(SIZE-Len(WORD$(W))-1)
  250. Y=Rnd(SIZE-1)+1
  251. If Y<Len(WORD$(W)) Then Goto UR
  252. REP=0
  253. For A=1 To Len(WORD$(W))
  254. If W$(X+A,Y-A)<>"" and(W$(X+A,Y-A)<>Mid$(WORD$(W),A,1)) Then REP=1
  255. Next A
  256. If REP=1 Then Goto UR
  257. For A=1 To Len(WORD$(W))
  258. W$(X+A,Y-A)=Mid$(WORD$(W),A,1)
  259. Next A
  260. X(W)=X : Y(W)=Y
  261. Return 
  262. '
  263. DL:
  264. Inc TRY
  265. If TRY>60 Then Return 
  266. X=Rnd(SIZE-1)+1
  267. If X<Len(WORD$(W)) Then Goto DL
  268. Y=Rnd(SIZE-Len(WORD$(W))-1)
  269. If Y<Len(WORD$(W)) Then Goto DL
  270. REP=0
  271. For A=1 To Len(WORD$(W))
  272. If W$(X-A,Y+A)<>"" and(W$(X-A,Y+A)<>Mid$(WORD$(W),A,1)) Then REP=1
  273. Next A
  274. If REP=1 Then Goto DL
  275. For A=1 To Len(WORD$(W))
  276. W$(X-A,Y+A)=Mid$(WORD$(W),A,1)
  277. Next A
  278. X(W)=X : Y(W)=Y
  279. Return 
  280. End Proc